subroutine icompsovv(vin, vout, fact)
use mod_ioff
use mod_orbit
use mod_iop 
use mod_symm
use mod_size
implicit none
real*8, intent(inout) :: fact
real*8, intent(inout) :: vin(*), vout(*)
!
integer c, d, a, b, irrepc, irrepd, irrepa, irrepb
integer numa, numb, numc, numd, ioffv(8), ioffv2(8)
integer irrepab, irrepcd, numab, numab2, numcd    
integer idxa, idxb, idxc, idxd, idx, ioffvv,nsize 
integer zorb2(8), idxin, idxout, ioffin, ioffout
integer, external :: irpdso, isymoffso, idsymsoc
real*8 dtmp
!
zorb2(1:8) = 1
!
!---------------for ABAB 
ioffv(1) = 1
ioffv2(1) = 1
do irrepcd = 1, nirrep - 1
   irrepab = dirprd(irrepcd, 1)
   numcd = irpdso(irrepcd, vrta, vrta, 1)
   numab = irpdso(irrepab, vrta, vrta, 1)
   ioffv(irrepcd+1) = ioffv(irrepcd) + numab*numcd
   numcd = irpdso(irrepcd, vrta, vrta, 2)
   numab = irpdso(irrepab, vrta, vrta, 2)
   ioffv2(irrepcd+1) = ioffv2(irrepcd) + numab*numcd
enddo
!
do irrepcd = 1, nirrep
   irrepab = dirprd(irrepcd, 1)
   numab = irpdso(irrepab, vrta, vrta, 1)
   numab2= irpdso(irrepab, vrta, vrta, 2)
   numcd = irpdso(irrepcd, vrta, vrta, 1)
   do irrepd = 1, nirrep
      irrepc = dirprd(irrepd, irrepcd) 
      numc = vrta(irrepc)
      numd = vrta(irrepd)
      do irrepb = 1, nirrep
         irrepa = dirprd(irrepb, irrepab)
         numa = vrta(irrepa)
         numb = vrta(irrepb)
         ioffin = ioffv(irrepcd)-1 &
              +  (isymoffso(irrepd, irrepcd, vrta, vrta, 1) -1 )*numab &
              +  isymoffso(irrepb,irrepab,vrta,vrta,1)-1 
         ioffout = ioffv2(irrepcd) - 1&
              +  (isymoffso(irrepd, irrepcd, vrta, vrta, 2) -1 )*numab2 &
              +  isymoffso(irrepb,irrepab,vrta,vrta,2)-1 
         if(irrepa>irrepb.or.irrepc>irrepd) cycle
         if(irrepa<irrepb.and.irrepc<irrepd) then 
               do d = 1, numd 
               do c = 1, numc 
               do b = 1, numb 
               do a = 1, numa 
                  idxin = ioffin + ((d-1)*numc+c-1)*numab &
                             +  (b-1)*numa + a
                  idxout = ioffout + ((d-1)*numc+c-1)*numab2 &
                             +  (b-1)*numa + a
                  vout(idxout) = vin(idxin)
               enddo
               enddo
               enddo
               enddo
         elseif(irrepa==irrepb.and.irrepc==irrepd) then 
               do d = 1, numd 
               do c = 1, d
               do b = 1, numb 
               do a = 1, b 
                  idxin = ioffin + ((d-1)*numc+c-1)*numab &
                             +  (b-1)*numa + a
                  idxout = ioffout + ((d-1)*d/2+c-1)*numab2 &
                             +  (b-1)*b/2 + a
                  vout(idxout) = vin(idxin)
               enddo
               enddo
               enddo
               enddo
               do d = 1, numd
               do b = 1, numb
               do a = 1, b
                  idxout = ioffout + ((d-1)*d/2+d-1)*numab2 &
                             +  (b-1)*b/2 + a
                  vout(idxout) = vout(idxout)*0.5d0
               enddo
               enddo
               enddo

         elseif(irrepa<irrepb.and.irrepc==irrepd) then
               do d = 1, numd
               do c = 1, d
               do b = 1, numb
               do a = 1, numa
                  idxin = ioffin + ((d-1)*numc+c-1)*numab &
                             +  (b-1)*numa + a
                  idxout = ioffout + ((d-1)*d/2+c-1)*numab2 &
                             +  (b-1)*numa + a
                  vout(idxout) = vin(idxin)
               enddo
               enddo
               enddo
               enddo

               do d = 1, numd
               do b = 1, numb
               do a = 1, numa
                  idxout = ioffout + ((d-1)*d/2+d-1)*numab2 &
                             +  (b-1)*numa + a
                  vout(idxout) = vout(idxout)*0.5d0
               enddo
               enddo
               enddo
         elseif(irrepa==irrepb.and.irrepc<irrepd) then
               do d = 1, numd
               do c = 1, numc
               do b = 1, numb
               do a = 1, b
                  idxin = ioffin + ((d-1)*numc+c-1)*numab &
                             +  (b-1)*numa + a
                  idxout = ioffout + ((d-1)*numc+c-1)*numab2 &
                             +  (b-1)*b/2 + a
                  vout(idxout) = vin(idxin)
               enddo
               enddo
               enddo
               enddo
          endif
      enddo
   enddo
enddo


return
end
